home *** CD-ROM | disk | FTP | other *** search
/ PC go! 2008 April / PCgo 2008-04 (DVD).iso / interface / contents / demoversionen_3846 / 13664 / files / Data1.cab / excel.cls < prev    next >
Encoding:
Visual Basic class definition  |  2006-11-25  |  7.1 KB  |  198 lines

  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "ExExport"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = True
  14. Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
  15. Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
  16. '/******************************************************************/
  17. '/*                                                                */
  18. '/*                      TurboCAD for Windows                      */
  19. '/*                   Copyright (c) 1993 - 2001                    */
  20. '/*             International Microcomputer Software, Inc.         */
  21. '/*                            (IMSI)                              */
  22. '/*                      All rights reserved.                      */
  23. '/*                                                                */
  24. '/******************************************************************/
  25. 'local variable(s) to hold property value(s)
  26. Private mvarClassID As String 'local copy
  27. Private mvarDescription As String 'local copy
  28. Private mvarInfo As String 'local copy
  29. Private mvarLastError As String 'local copy
  30. Dim ExApp As Excel.Application
  31. Dim pWbs As Workbooks
  32. Dim pWb As Workbook
  33. Dim pWss As Worksheets
  34. Dim pWs As Worksheet
  35. Private Init1 As Boolean
  36. Dim nGraphicsCount As Long
  37. Dim Grs As Graphics
  38. Public Property Get Info() As String
  39.         Info = "MSEExport.ExExport,SDK sample filter Microsoft Excel File,0,10,xls,xls"
  40. End Property
  41.  
  42. Public Function Initialize(ByVal ThisFilter As Object) As Boolean
  43.     Initialize = True
  44. End Function
  45.  
  46. Public Function WriteSetup(ByVal ThisFilter As Object) As Boolean
  47.     ' setup setting for our filter
  48.  
  49.     'MsgBox "Not implemented yet. " & vbCrLf & "Add your code here !"
  50.     MsgBox "Not implemented. " & vbCrLf & "You can add the code yourself.", , "XLS file export"
  51.  
  52. End Function
  53.  
  54.  
  55. Public Function WriteFlat(ByVal FileName As String, ByVal Aspect As Long, ByVal Graphics As Object, Optional Query As Variant) As Long
  56. On Error GoTo ExcelWontInit
  57.     
  58. ' Create Microsoft Excel application
  59.     Set ExApp = CreateObject("Excel.Application")
  60.     Set pWbs = ExApp.Workbooks
  61. ' create new workbook
  62.     Set pWb = pWbs.Add
  63.     Set pWs = pWb.Worksheets(1) '.Add
  64.     Set Grs = Graphics
  65.     nGraphicsCount = Grs.Count
  66.     ' fill timesheet with graphic's data
  67.     Call Fill_Sheet(pWs, "Graphic's properties")
  68.     
  69.     Set Grs = Nothing
  70.     pWb.SaveAs FileName ', , , , , , xlShared
  71.     pWb.Close
  72.     pWbs.Close
  73.     
  74.     ExApp.Quit
  75.     
  76.     Set pWs = Nothing
  77.     Set pWb = Nothing
  78.     Set pWbs = Nothing
  79.     Set ExApp = Nothing
  80.     Exit Function
  81. ExcelWontInit:
  82.     MsgBox "Can't initiaize Excel Application. Probably there is not Excel installed !"
  83.     MsgBox Err.Description
  84.     Err.Clear
  85.     If Not ExApp Is Nothing Then
  86.         ExApp.Quit
  87.     End If
  88.     
  89.     Set pWs = Nothing
  90.     Set pWb = Nothing
  91.     Set pWbs = Nothing
  92.     Set ExApp = Nothing
  93. End Function
  94.  
  95. Public Function PreviewFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal WidthA As Long, ByVal HeightA As Long, Description As String, Thumbnail As Variant) As Long
  96.     PreviewFlat = -1
  97. End Function
  98.  
  99. Public Function CheckFlat(ByVal ThisFilter As Object, ByVal FileName As String, ByVal Aspect As Long, ByVal Query As Variant) As Long
  100. End Function
  101.  
  102. Public Property Get LastError() As String
  103. Attribute LastError.VB_Description = "Get"
  104. 'used when retrieving value of a property, on the right side of an assignment.
  105. 'Syntax: Debug.Print X.LastError
  106.     LastError = mvarLastError
  107. End Property
  108.  
  109. ' GetInfo:  return the filter's info string
  110. ' Our info string is "MSEExport.Excel,Microsoft Excel File,0,10,xls,xls", stored in the DLL's
  111. ' resource.
  112.  
  113. ' The info string contains the following fields, delimited by commas:
  114. ' Field Name                                Value
  115. ' 1.    Filter ID                           "MSEExport.Excel"
  116. ' the Filter ID must contains 32 symbols not more'
  117. ' otherwise your custom filter will not registered properly by turboCAD
  118. '        Used as the internal name (must be unique).
  119. '        Should be the same as the ProgID registered for the server.
  120. '        TurboCAD reserves names beginning with an asterisk.
  121. ' 2.    File type string for common dialog  "Microsoft Excel File";
  122. '        This string appears in Windows dialog file type combo box.
  123. ' 3.    Document type handled by filter     0
  124. '        This should always be zero for automation filters.
  125. ' 4.    Priority                            10
  126. '        Arbitrary integer value used to determine search order for multiple filters which
  127. '        support the same document type and file extension.
  128. ' 5.    Exported function name prefix       "xls"
  129. '        Not used by automation filters, but a non-blank string must be supplied.
  130. ' 6-n.  File extensions                     "xls"
  131. '        Used in common dialog and for matching.
  132.  
  133.  
  134. Public Property Get Description() As String
  135. Attribute Description.VB_Description = "Get"
  136. 'used when retrieving value of a property, on the right side of an assignment.
  137. 'Syntax: Debug.Print X.Description
  138.     Description = mvarDescription
  139. End Property
  140.  
  141.  
  142. Public Property Get ClassID() As String
  143. Attribute ClassID.VB_Description = "Get"
  144. 'used when retrieving value of a property, on the right side of an assignment.
  145. 'Syntax: Debug.Print X.ClassID
  146.     ClassID = mvarClassID
  147. End Property
  148. Private Sub Fill_Sheet(W As Worksheet, SheetName As String)
  149.     ' declare array to store graphic's data
  150.     Dim InfoArray() As String
  151.     Dim i As Long
  152.     Dim j As Long
  153.     Dim Gr As Graphic
  154.   
  155.     W.Name = SheetName '"Graphic's properties"
  156.     
  157. ' adjust array size in accordance with count of graphics and count of graphic properties to be exported
  158. ' in this example we export values of 5 properties for each graphic
  159. ' so array is nGraphicsCount x 5
  160.     ReDim InfoArray(nGraphicsCount, 5)
  161. ' first row in this array store Property Name (Column name in Excel spreadsheet)
  162.     InfoArray(0, 0) = "GraphicType"
  163.     InfoArray(0, 1) = "GraphicInfo"
  164.     InfoArray(0, 2) = "PenColor"
  165.     InfoArray(0, 3) = "PenStyle"
  166.     InfoArray(0, 4) = "Layer"
  167.     InfoArray(0, 5) = "GraphicID"
  168.     On Error Resume Next
  169.     ' fill array
  170.     i = 0
  171.     j = 0
  172.      For Each Gr In Grs
  173.             Set Gr = Grs(i)
  174.             InfoArray(i + 1, j) = Gr.Type
  175.             InfoArray(i + 1, j + 1) = Gr.Properties("Info")
  176.             InfoArray(i + 1, j + 2) = Gr.Properties("PenColor")
  177.             InfoArray(i + 1, j + 3) = Gr.Properties("PenStyle")
  178.             InfoArray(i + 1, j + 4) = Gr.Properties("Layer")
  179.             InfoArray(i + 1, j + 5) = Gr.ID
  180.             i = i + 1
  181.     Next
  182.     
  183.     i = 0
  184.     j = 0
  185.     
  186.     For i = 0 To nGraphicsCount
  187.         W.Cells(i + 1, j + 1) = InfoArray(i, j)
  188.         For j = 1 To 5
  189.             W.Cells(1, 1).Colo
  190.             W.Cells(i + 1, j + 1) = InfoArray(i, j)
  191.         Next j
  192.         j = 0
  193.     Next i
  194.     W.Columns.AutoFit
  195.  
  196. End Sub
  197.  
  198.